home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / libguile / ports.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-07  |  12.1 KB  |  532 lines
  1. /*    Copyright (C) 1995 Free Software Foundation, Inc.
  2.  * 
  3.  * This program is free software; you can redistribute it and/or modify
  4.  * it under the terms of the GNU General Public License as published by
  5.  * the Free Software Foundation; either version 2, or (at your option)
  6.  * any later version.
  7.  * 
  8.  * This program is distributed in the hope that it will be useful,
  9.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11.  * GNU General Public License for more details.
  12.  * 
  13.  * You should have received a copy of the GNU General Public License
  14.  * along with this software; see the file COPYING.  If not, write to
  15.  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  16.  *
  17.  * As a special exception, the Free Software Foundation gives permission
  18.  * for additional uses of the text contained in its release of GUILE.
  19.  *
  20.  * The exception is that, if you link the GUILE library with other files
  21.  * to produce an executable, this does not by itself cause the
  22.  * resulting executable to be covered by the GNU General Public License.
  23.  * Your use of that executable is in no way restricted on account of
  24.  * linking the GUILE library code into it.
  25.  *
  26.  * This exception does not however invalidate any other reasons why
  27.  * the executable file might be covered by the GNU General Public License.
  28.  *
  29.  * This exception applies only to the code released by the
  30.  * Free Software Foundation under the name GUILE.  If you copy
  31.  * code from other Free Software Foundation releases into a copy of
  32.  * GUILE, as the General Public License permits, the exception does
  33.  * not apply to the code that you add in this way.  To avoid misleading
  34.  * anyone as to the status of such modified files, you must delete
  35.  * this exception notice from them.
  36.  *
  37.  * If you write modifications of your own for GUILE, it is your choice
  38.  * whether to permit this exception to apply to your modifications.
  39.  * If you do not wish that, delete this exception notice.  
  40.  */
  41.  
  42.  
  43. #include <stdio.h>
  44. #include "_scm.h"
  45.  
  46.  
  47.  
  48.  
  49. /* scm_ptobs scm_numptob
  50.  * implement a dynamicly resized array of ptob records.
  51.  * Indexes into this table are used when generating type
  52.  * tags for smobjects (if you know a tag you can get an index and conversely).
  53.  */
  54. scm_ptobfuns *scm_ptobs;
  55. sizet scm_numptob;
  56.  
  57. long 
  58. scm_newptob (ptob)
  59.      scm_ptobfuns *ptob;
  60. {
  61.   char *tmp;
  62.   if (255 <= scm_numptob)
  63.     goto ptoberr;
  64.   DEFER_INTS;
  65.   SYSCALL (tmp = (char *) realloc ((char *) scm_ptobs, (1 + scm_numptob) * sizeof (scm_ptobfuns)));
  66.   if (tmp)
  67.     {
  68.       scm_ptobs = (scm_ptobfuns *) tmp;
  69.       scm_ptobs[scm_numptob].mark = ptob->mark;
  70.       scm_ptobs[scm_numptob].free = ptob->free;
  71.       scm_ptobs[scm_numptob].print = ptob->print;
  72.       scm_ptobs[scm_numptob].equalp = ptob->equalp;
  73.       scm_ptobs[scm_numptob].fputc = ptob->fputc;
  74.       scm_ptobs[scm_numptob].fputs = ptob->fputs;
  75.       scm_ptobs[scm_numptob].fwrite = ptob->fwrite;
  76.       scm_ptobs[scm_numptob].fflush = ptob->fflush;
  77.       scm_ptobs[scm_numptob].fgetc = ptob->fgetc;
  78.       scm_ptobs[scm_numptob].fclose = ptob->fclose;
  79.       scm_numptob++;
  80.     }
  81.   ALLOW_INTS;
  82.   if (!tmp)
  83.   ptoberr:scm_wta (MAKINUM ((long) scm_numptob), (char *) NALLOC, "newptob");
  84.   return tc7_port + (scm_numptob - 1) * 256;
  85. }
  86.  
  87.  
  88.  
  89.  
  90. /* {Ports - in general}
  91.  * 
  92.  */
  93.  
  94. /* Array of open ports, required for reliable MOVE->FDES etc.  */
  95. struct scm_port_table *scm_port_table;
  96.  
  97. int scm_port_table_size = 0;    /* Number of ports in scm_port_table.  */
  98. int scm_port_table_room = 20;    /* Size of the array.  */
  99.  
  100. /* Add a port to the table.  Call with DEFER_INTS active.  */
  101. #ifdef __STDC__
  102. void
  103. scm_add_to_port_table (SCM port)
  104. #else
  105. void
  106. scm_add_to_port_table (port)
  107.      SCM port;
  108. #endif
  109. {
  110.   if (scm_port_table_size == scm_port_table_room) {
  111.     scm_port_table = (struct scm_port_table *)
  112.       scm_must_realloc ((char *) scm_port_table,
  113.             (long) (sizeof (struct scm_port_table)
  114.             * scm_port_table_room),
  115.             (long) (sizeof (struct scm_port_table)
  116.             * scm_port_table_room * 2),
  117.             "port list");
  118.     scm_port_table_room *= 2;
  119.   }
  120.   scm_port_table[scm_port_table_size].port = port;
  121.   scm_port_table[scm_port_table_size].revealed = 0;
  122.   scm_port_table_size++;
  123. }
  124.  
  125. /* Remove a port from the table.  Call with DEFER_INTS active.  */
  126. #ifdef __STDC__
  127. void
  128. scm_remove_from_port_table (SCM port)
  129. #else
  130. void
  131. scm_remove_from_port_table (port)
  132.      SCM port;
  133. #endif
  134. {
  135.   int i = 0;
  136.   while (scm_port_table[i].port != port)
  137.     {
  138.       i++;
  139.       /* Error if not found: too violent?  May occur in GC.  */
  140.       if (i >= scm_port_table_size)
  141.     scm_wta (port, "Port not in table", "scm_remove_from_port_table");
  142.     }
  143.   scm_port_table[i].port = scm_port_table[scm_port_table_size - 1].port;
  144.   scm_port_table[i].revealed
  145.     = scm_port_table[scm_port_table_size - 1].revealed;
  146.   scm_port_table_size--;
  147. }
  148.  
  149. #ifdef DEBUG
  150. /* Undocumented functions for debugging.  */
  151. /* Return the number of ports in the table.  */
  152. static char s_pt_size[] = "pt-size";
  153. #ifdef __STDC__
  154. SCM
  155. scm_pt_size (void)
  156. #else
  157. SCM
  158. scm_pt_size ()
  159. #endif
  160. {
  161.   return MAKINUM (scm_port_table_size);
  162. }
  163.  
  164. /* Return the ith member of the port table.  */
  165. static char s_pt_member[] = "pt-member";
  166. #ifdef __STDC__
  167. SCM
  168. scm_pt_member (SCM member)
  169. #else
  170. SCM
  171. scm_pt_member (member)
  172.      SCM member;
  173. #endif
  174. {
  175.   int i;
  176.   ASSERT (INUMP (member), member, ARG1, s_pt_member);
  177.   i = INUM (member);
  178.   if (i < 0 || i >= scm_port_table_size)
  179.     return BOOL_F;
  180.   else
  181.     return scm_port_table[i].port;
  182. }
  183. #endif
  184.  
  185. /* Close all ports except those listed.  Useful when creating new
  186.  * processes.
  187.  */
  188.  
  189. PROC (s_close_all_ports_except, "close-all-ports-except", 0, 0, 1, scm_close_all_ports_except);
  190. #ifdef __STDC__
  191. SCM
  192. scm_close_all_ports_except (SCM ports)
  193. #else
  194. SCM
  195. scm_close_all_ports_except (ports)
  196.      SCM ports;
  197. #endif
  198. {
  199.   int i = 0;
  200.   ASSERT (NIMP (ports) && CONSP (ports), ports, ARG1, s_close_all_ports_except);
  201.   DEFER_INTS;  
  202.   while (i < scm_port_table_size)
  203.     {
  204.       SCM thisport = scm_port_table[i].port;
  205.       int found = 0;
  206.       SCM ports_ptr = ports;
  207.  
  208.       while (NNULLP (ports_ptr))
  209.     {
  210.       SCM port = CAR (ports_ptr);
  211.       if (i == 0)
  212.         ASSERT (NIMP (port) && OPPORTP (port), port, ARG1, s_close_all_ports_except);
  213.       if (port == thisport)
  214.         found = 1;
  215.       ports_ptr = CDR (ports_ptr);
  216.     }
  217.       if (found)
  218.     i++;
  219.       else
  220.     /* i is not to be incremented here.  */
  221.     scm_close_port (thisport);
  222.     }
  223.   ALLOW_INTS;
  224.   return UNSPECIFIED;
  225. }
  226.  
  227. /* Find a port in the table and return its revealed count.  Return -1
  228.  * if the port isn't in the table (should not happen).  Also used by
  229.  * the garbage collector.
  230.  */
  231. #ifdef __STDC__
  232. int
  233. scm_revealed_count (SCM port)
  234. #else
  235. int
  236. scm_revealed_count (port)
  237.      SCM port;
  238. #endif
  239. {
  240.   int i;
  241.  
  242.   for (i = 0; i < scm_port_table_size; i++)
  243.     {
  244.       if (scm_port_table[i].port == port)
  245.     return scm_port_table[i].revealed;
  246.     }
  247.   return -1;
  248. }
  249.  
  250.  
  251. PROC (s_port_to_descriptor, "port->descriptor", 1, 0, 0, scm_port_to_descriptor);
  252. #ifdef __STDC__
  253. SCM
  254. scm_port_to_descriptor (SCM port)
  255. #else
  256. SCM
  257. scm_port_to_descriptor (port)
  258.      SCM port;
  259. #endif
  260. {
  261.   int it;
  262.   ASSERT (NIMP (port) && FPORTP (port), port, ARG1, s_port_to_descriptor);
  263.   DEFER_INTS;
  264.   it = fileno (STREAM (port));
  265.   ALLOW_INTS;
  266.   return MAKINUM (it);
  267. }
  268.  
  269. /* Return the revealed count for a port.  */
  270.  
  271. PROC (s_port_revealed, "port-revealed", 1, 0, 0, scm_port_revealed);
  272. #ifdef __STDC__
  273. SCM
  274. scm_port_revealed (SCM port)
  275. #else
  276. SCM
  277. scm_port_revealed (port)
  278.      SCM port;
  279. #endif
  280. {
  281.   int result;
  282.  
  283.   ASSERT (NIMP (port) && PORTP (port), port, ARG1, s_port_revealed);
  284.  
  285.   if ((result = scm_revealed_count (port)) == -1)
  286.     return BOOL_F;
  287.   else
  288.     return MAKINUM (result);
  289. }
  290.  
  291. /* Set the revealed count for a port.  */
  292. PROC (s_set_port_revealed_x, "set-port-revealed!", 2, 0, 0, scm_set_port_revealed_x);
  293. #ifdef __STDC__
  294. SCM
  295. scm_set_port_revealed_x (SCM port, SCM rcount)
  296. #else
  297. SCM
  298. scm_set_port_revealed_x (port, rcount)
  299.      SCM port;
  300.      SCM rcount;
  301. #endif
  302. {
  303.   int i;
  304.  
  305.   ASSERT (NIMP (port) && PORTP (port), port, ARG1, s_set_port_revealed_x);
  306.   ASSERT (INUMP (rcount), rcount, ARG2, s_set_port_revealed_x);
  307.   DEFER_INTS;
  308.   for (i = 0; i < scm_port_table_size; i++)
  309.     {
  310.       if (scm_port_table[i].port == port) {
  311.     scm_port_table[i].revealed = INUM (rcount);
  312.     return BOOL_T;
  313.       }
  314.     }
  315.   ALLOW_INTS;
  316.   return BOOL_F;
  317. }
  318.  
  319. /* FIXME  */
  320. #ifdef __STDC__
  321. void
  322. scm_setfileno (FILE *fs, int fd)
  323. #else
  324. void
  325. scm_setfileno (fs, fd)
  326.      FILE *fs;
  327.      int fd;
  328. #endif
  329. {
  330. #ifdef FILE_FD_FIELD
  331.   fs->FILE_FD_FIELD = fd;
  332. #else
  333.   Configure could not guess the name of the correct field in a FILE *.
  334.   This function needs to be ported to your system.
  335.   It should change the descriptor refered to by a stdio stream, and nothing
  336.   else.
  337. #endif
  338. }
  339.  
  340. /* Move ports with the specified file descriptor to new descriptors,
  341.  * reseting the revealed count to 0.
  342.  * Should be called with DEFER_INTS active.
  343.  */
  344. #ifdef __STDC__
  345. void
  346. scm_evict_ports (int fd)
  347. #else
  348. void
  349. scm_evict_ports (fd)
  350.      int fd;
  351. #endif
  352. {
  353.   int i;
  354.  
  355.   for (i = 0; i < scm_port_table_size; i++)
  356.     {
  357.       if (FPORTP (scm_port_table[i].port)
  358.       && fileno (STREAM (scm_port_table[i].port)) == fd)
  359.     {
  360.       scm_setfileno (STREAM (scm_port_table[i].port), dup (fd));
  361.       scm_set_port_revealed_x (scm_port_table[i].port, MAKINUM (0));
  362.     }
  363.     }
  364. }
  365.  
  366. /* Return a list of ports using a given file descriptor.  */
  367. PROC (s_fdes_to_ports, "fdes->ports", 1, 0, 0, scm_fdes_to_ports);
  368. #ifdef __STDC__
  369. SCM
  370. scm_fdes_to_ports (SCM fd)
  371. #else
  372. SCM
  373. scm_fdes_to_ports (fd)
  374.      SCM fd;
  375. #endif
  376. {
  377.   SCM result = EOL;
  378.   int int_fd;
  379.   int i;
  380.   
  381.   ASSERT (INUMP (fd), fd, ARG1, s_fdes_to_ports);
  382.   int_fd = INUM (fd);
  383.  
  384.   DEFER_INTS;
  385.   for (i = 0; i < scm_port_table_size; i++)
  386.     {
  387.       if (FPORTP (scm_port_table[i].port)
  388.       && fileno (STREAM (scm_port_table[i].port)) == int_fd)
  389.     result = scm_cons (scm_port_table[i].port, result);
  390.     }
  391.   ALLOW_INTS;
  392.   return result;
  393. }    
  394.  
  395.  
  396. /* scm_close_port
  397.  * Call the close operation on a port object. 
  398.  */
  399. PROC (s_close_port, "close-port", 1, 0, 0, scm_close_port);
  400. #ifdef __STDC__
  401. SCM
  402. scm_close_port (SCM port)
  403. #else
  404. SCM
  405. scm_close_port (port)
  406.      SCM port;
  407. #endif
  408. {
  409.   sizet i;
  410.   ASSERT (NIMP (port) && PORTP (port), port, ARG1, s_close_port);
  411.   if (CLOSEDP (port))
  412.     return UNSPECIFIED;
  413.   i = PTOBNUM (port);
  414.   DEFER_INTS;
  415.   if (scm_ptobs[i].fclose)
  416.     SYSCALL ((scm_ptobs[i].fclose) (STREAM (port)));
  417.   scm_remove_from_port_table (port);
  418.   CAR (port) &= ~OPN;
  419.   ALLOW_INTS;
  420.   return UNSPECIFIED;
  421. }
  422.  
  423.  
  424. PROC (s_input_port_p, "input-port?", 1, 0, 0, scm_input_port_p);
  425. #ifdef __STDC__
  426. SCM 
  427. scm_input_port_p (SCM x)
  428. #else
  429. SCM 
  430. scm_input_port_p (x)
  431.      SCM x;
  432. #endif
  433. {
  434.   if (IMP (x))
  435.  return BOOL_F;
  436.   return INPORTP (x) ? BOOL_T : BOOL_F;
  437. }
  438.  
  439. PROC (s_output_port_p, "output-port?", 1, 0, 0, scm_output_port_p);
  440. #ifdef __STDC__
  441. SCM 
  442. scm_output_port_p (SCM x)
  443. #else
  444. SCM 
  445. scm_output_port_p (x)
  446.      SCM x;
  447. #endif
  448. {
  449.   if (IMP (x))
  450.  return BOOL_F;
  451.   return OUTPORTP (x) ? BOOL_T : BOOL_F;
  452. }
  453.  
  454.  
  455. #ifndef ttyname
  456. extern char * ttyname();
  457. #endif
  458.  
  459. #ifdef __STDC__
  460. void 
  461. scm_prinport (SCM exp, SCM port, char *type)
  462. #else
  463. void 
  464. scm_prinport (exp, port, type)
  465.      SCM exp;
  466.      SCM port;
  467.      char *type;
  468. #endif
  469. {
  470.   scm_puts ("#<", port);
  471.   if (CLOSEDP (exp))
  472.     scm_puts ("closed-", port);
  473.   else
  474.     {
  475.       if (RDNG & CAR (exp))
  476.     scm_puts ("input-", port);
  477.       if (WRTNG & CAR (exp))
  478.     scm_puts ("output-", port);
  479.     }
  480.   scm_puts (type, port);
  481.   scm_putc (' ', port);
  482. #ifndef MSDOS
  483. #ifndef __EMX__
  484. #ifndef _DCC
  485. #ifndef AMIGA
  486. #ifndef THINK_C
  487.   if (OPENP (exp) && tc16_fport == TYP16 (exp) && isatty (fileno (STREAM (exp))))
  488.     scm_puts (ttyname (fileno (STREAM (exp))), port);
  489.   else
  490. #endif
  491. #endif
  492. #endif
  493. #endif
  494. #endif
  495.   if (OPFPORTP (exp))
  496.     scm_intprint ((long) fileno (STREAM (exp)), 10, port);
  497.   else
  498.     scm_intprint (CDR (exp), 16, port);
  499.   scm_putc ('>', port);
  500. }
  501.  
  502. #ifdef __STDC__
  503. void
  504. scm_ports_prehistory (void)
  505. #else
  506. void
  507. scm_ports_prehistory ()
  508. #endif
  509. {
  510.   scm_numptob = 0;
  511.   scm_ptobs = (scm_ptobfuns *) malloc (4 * sizeof (scm_ptobfuns));
  512.   
  513.   /* WARNING: These scm_newptob calls must be done in this order */
  514.   /* tc16_fport = */ scm_newptob (&scm_fptob);
  515.   /* tc16_pipe = */ scm_newptob (&scm_pipob);
  516.   /* tc16_strport = */ scm_newptob (&scm_stptob);
  517.   /* tc16_sfport = */ scm_newptob (&scm_sfptob);
  518. }
  519.  
  520.  
  521. #ifdef __STDC__
  522. void
  523. scm_init_ports (void)
  524. #else
  525. void
  526. scm_init_ports ()
  527. #endif
  528. {
  529. #include "ports.x"
  530. }
  531.  
  532.